SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00002 1 05-25-9408:09ALL BILL MULLEN DOS Shell SWAG9405 39 U {π ┌── GEORGE VAISEY ───────────────────────────────────────────────────┐π │ GV» I've read throught the book and even looked it up in the two │π │ GV» pascal books I've got and can't seem to get any help.I'm │π │ GV» trying (without luck) to get this this command: │π │ GV» trying (without luck) to get this this PROMPT $mTYPE "EXIT" TO │π │ GV» RETURN to be sent as a command before it shells. This is so │π │ GV» that the individual that shells out will always know that he │π │ GV» needs to type EXIT to return. If you can help or know of a │π │ GV» better way PLEASE let me know. Here is what I use to shell to │π │ GV» OS: │π │ │π │ GV» Begin │π │ GV» ClrScr; │π │ GV» TextColor(Yellow+Blink); │π │ GV» Writeln ('Type EXIT To Return To Program'); │π │ GV» SwapVectors; │π │ GV» Exec(GetEnv('Comspec'), ''); │π │ GV» SwapVectors; │π │ GV» NormVideo; │π │ GV» End. │π │ GV» I want it to be │π │ GV» TYPE "EXIT" TO RETURN │π │ GV» then the prompt command. Thanks again for your help. │π │ GV» George Vaisey │π └────────────────────────────────────────────────────────────────────┘ππGeorge,ππ You should get either Object Professional or Turbo Professional fromπ Turbo Power software (800) 333-4160 and use the xxDOS unit. It hasπ routines in it to change environment variables on the fly. Theseπ routines work really well.ππ In the mean time you can use the technique shown in the code below.π Beware however, that you MUST have enough environment space to dealπ with the extra space required and that there will actually be twoπ copies of COMMAND.COM running in addition to the master copy.ππ The technique shown in SHELLTODOS is not exactly what you asked for, butπ it does show you how to do what you want. SHELLTODOS1 is the code usedπ if you have either Object Pro or Turbo Pro.ππ P.S. Long lines of code may get truncated by my "QWK" mailer. Inspectπ the SHELLMESSAGE procedure as it appears it may get truncated. Alsoπ change all the WRITE commands in SHELLMESSAGE to WRITELN's.ππ[-------------------------------CUT HERE-----------------------------------]π}ππ{$M 4096, 0, 655360 }πProgram DosShell;πusesπ OpDos, { Needed only by SHELLTODOS1 }π Memory,π Dos,π CRT;πππProcedure ShellMessage ( ProgName : String );π Function Extend ( AStr : String; ML : byte ) : String;π beginπ while ord ( AStr[0] ) < ML doπ AStr := AStr + ' ';π Extend := AStr;π end;πbeginπ clrscr;π Change the following 6 lines to WRITELN's then delete this line entirely.π write(' ╔═════════════════════════════════════════════════════════════════╗');π write(' ║ ■ While in the DOS SHELL, do not execute any TSR programs like ║');π write(' ║ SideKick or DOS''s PRINT command. ║')π write(' ║ ■ Type EXIT and press ENTER to quit the SHELL and return to the ║');π write(Extend ( ' ║ ' + ProgName + ' program.', 67 ), '║' );π write(' ╚═════════════════════════════════════════════════════════════════╝');πend;πππProcedure ShellToDos ( ProgName : string );πvarπ T : text;π D : string;πbeginπ (* Save current directory *)π GetDir ( 0, D );ππ (* Create a DOS batch file with a PROMPT command *)π assign ( T, 'DOSSHELL.BAT' );π rewrite ( T );π writeln ( T, '@echo off' );π writeln ( T, 'Prompt [EXIT] $p$g' );π writeln ( T, GetEnv ( 'COMSPEC' ) );π close ( T );ππ (* Execute the batch file which in turn executes COMMAND.COM *)π ShellMessage ( ProgName );π DoneDosMem;π swapvectors;π exec ( GetEnv ( 'COMSPEC' ), '/c DOSSHELL.BAT' );π swapvectors;π InitDosMem;ππ (* Erase the batch file and restore the working directory *)π erase ( T );π chdir ( D );πend;πππProcedure ShellToDos1 ( ProgName : string );πvarπ NewPrompt : String;π D : string;πbeginπ getdir ( 0, D );π ShellMessage ( ProgName );π NewPrompt := 'Type "EXIT" and press ENTER to return to DOSSHELL'^M^J+π '[' + ProgName + '] ' + GetEnvironmentString ('PROMPT');π ShellWithPrompt ( NewPrompt, NoExecDosProc );π chdir ( D );πend;πππbeginπ InitMemory;π ShellToDos ( 'DosShell' );π ShellToDos1 ( 'DosShell' );π DoneMemory;πend.π 2 05-26-9408:32ALL GAYLE DAVIS Execute PKZIP SWAG9405 67 U UNIT PKZExec;ππINTERFACEππUSES DOS;ππ{ Purpose : Execute PKZIP/PKUNZIP on archive files }π{ Uses specialized EXEC procedure so main program can use ALL of the memory }π{ Also shows how to take over INT29 to NOT display anything on the CRT }ππCONSTπ PKZIP : PathStr = 'PKZIP.EXE';π PKUNZIP : PathStr = 'PKUNZIP.EXE';ππVAR ZIPError : INTEGER;ππPROCEDURE CleanUpDir (WorkDir, FileMask : STRING);π {Erases files based on a mask }ππPROCEDURE DisplayZIPError;π { PKZip interface }ππPROCEDURE DefaultCleanup (WorkDir : STRING);π {Erases files *.BAK, *.MAP, temp*.*}ππPROCEDURE ShowEraseStats;π {shows count & bytes recovered}ππFUNCTION UnZIPFile (ZIPOpts, ZIPName, DPath, fspec : STRING; qt : BOOLEAN) : BOOLEAN;π {Uses PKUnZip to de-archive files }ππFUNCTION ZIPFile (ZIPOpts, ZIPName, fspec : STRING; qt : BOOLEAN) : BOOLEAN;π {Uses PKZip to archive files }ππIMPLEMENTATIONππVAR ZIPDefaultZIPOpts : STRING [16];πVAR ZIPFileName : STRING [50];πVAR ZIPDPath : STRING [50];ππVAR EraseCount : WORD; { files erased }π EraseSizeK : LONGINT; { kilobytes released by erasing files }π ShowOnWrite : BOOLEAN;π I29H : POINTER;ππ{ EXECUTE STUFF - SHRINK HEAP AND EXECUTE LIKE EXECDOS }ππ{$F+}πPROCEDURE Int29Handler (AX, BX, CX, DX, SI, DI, DS, ES, BP : WORD); INTERRUPT;πVARπ Dummy : BYTE;πBEGINπ Asmπ Stiπ END;π IF ShowOnWrite THEN WRITE (CHAR (LO (Ax) ) );π Asmπ Cliπ END;πEND;ππPROCEDURE ReallocateMemory (P : POINTER); ASSEMBLER;πASMπ MOV AX, PrefixSegπ MOV ES, AXπ MOV BX, WORD PTR P + 2π CMP WORD PTR P, 0π JE @OKπ INC BXππ @OK :π SUB BX, AXπ MOV AH, 4Ahπ INT 21hπ JC @Xπ LES DI, Pπ MOV WORD PTR HeapEnd, DIπ MOV WORD PTR HeapEnd + 2, ESπ @X :πEND;ππ{ ZAP this DEFINE if NOT 386,486}π{..$DEFINE CPU386}ππFUNCTION EXECUTE (Name : PathStr ; Tail : STRING) : WORD; ASSEMBLER;πASMπ {$IFDEF CPU386}π DB 66hπ PUSH WORD PTR HeapEndπ DB 66hπ PUSH WORD PTR Nameπ DB 66hπ PUSH WORD PTR Tailπ DB 66hπ PUSH WORD PTR HeapPtrπ {$ELSE}π PUSH WORD PTR HeapEnd + 2π PUSH WORD PTR HeapEndπ PUSH WORD PTR Name + 2π PUSH WORD PTR Nameπ PUSH WORD PTR Tail + 2π PUSH WORD PTR Tailπ PUSH WORD PTR HeapPtr + 2π PUSH WORD PTR HeapPtrπ {$ENDIF}ππ CALL ReallocateMemoryπ CALL SwapVectorsπ CALL DOS.EXECπ CALL SwapVectorsπ CALL ReallocateMemoryπ MOV AX, DosErrorπ OR AX, AXπ JNZ @OUTπ MOV AH, 4Dhπ INT 21hπ @OUT :πEND;π{$F-}ππFUNCTION ExecuteCommand(p,s : STRING; quiet : BOOLEAN) : INTEGER;πBEGINπShowOnWrite := NOT quiet; { turn off INT 29 }πGETINTVEC ($29, I29H);πSETINTVEC ($29, @Int29Handler); { Install interrupt handler }πExecute(p,s);πSETINTVEC ($29, I29h);πIF DosError = 0 THEN ExecuteCommand := DosExitCode ELSE ExecuteCommand := DosError;πEND;ππFUNCTION AddBackSlash (dName : STRING) : STRING;πBEGINπ IF dName [LENGTH (dName) ] IN ['\', ':', #0] THENπ AddBackSlash := dNameπ ELSEπ AddBackSlash := dName + '\';πEND;ππFUNCTION EraseFile ( S : PathStr ) : BOOLEAN ;ππVAR F : FILE;ππBEGINππEraseFile := FALSE;ππASSIGN (F, S);πRESET (F);ππIF IORESULT <> 0 THEN EXIT;ππ CLOSE (F);π ERASE (F);π EraseFile := (IORESULT = 0);ππEND;ππFUNCTION FileExists ( S : PathStr ) : BOOLEAN ;ππVAR F : FILE;ππBEGINππFileExists := FALSE;ππASSIGN (F, S);πRESET (F);ππIF IORESULT <> 0 THEN EXIT;ππ CLOSE (F);π FileExists := (IORESULT = 0);ππEND;ππPROCEDURE CleanUpFile (WorkDir : STRING; SR : searchRec);πVAR l : LONGINT;π BEGINπ WITH SR DOπ BEGINπ l := size DIV 512;π IF (attr AND 31) = 0 THENπ BEGINπ IF l = 0 THEN l := 1;π EraseSizeK := EraseSizeK + l;π WRITELN (' Removing: ', (AddBackSlash (WorkDir) + name),π ' ', l DIV 2, 'k');π EraseFile (AddBackSlash (WorkDir) + name);π INC (EraseCount);π ENDπ ELSE WRITELN (' ?? ', (AddBackSlash (WorkDir) + name), ' ', l DIV 2, 'k',π ' attr: ', attr);π END;π END;πππPROCEDURE CleanUpDir (WorkDir, FileMask : STRING);πVAR Frec : SearchRec;π s : STRING [64];π BEGINπ s := '';π FINDFIRST (AddBackSlash (WorkDir) + FileMask, anyfile, Frec);π WHILE doserror = 0 DOπ BEGINπ CleanUpFile (WorkDir, Frec);π FINDNEXT (Frec);π END;π END;πππPROCEDURE DefaultCleanup (WorkDir : STRING);π BEGINπ CleanUpDir (WorkDir, '*.BAK');π CleanUpDir (WorkDir, '*.MAP');π CleanUpDir (WorkDir, 'TEMP*.*');π END;πππPROCEDURE DisplayZIPError;π BEGINπ CASE ziperror OFπ 0 : WRITELN ('no error');π 2,3 : WRITELN (ziperror : 3, ' Error in ZIP file ');π 4..8 : WRITELN (ziperror : 3, ' Insufficient Memory');π 11,12 : WRITELN (ziperror : 3, ' No MORE files ');π 9,13 : WRITELN (ziperror : 3, ' File NOT found ');π 14,50 : WRITELN (ziperror : 3, ' Disk FULL !! ');π 51 : WRITELN (ziperror : 3, ' Unexpected EOF in ZIP file ');π 15 : WRITELN (ziperror : 3, ' Zip file is Read ONLY! ');π 10,16 : WRITELN (ziperror : 3, ' Bad or illegal parameters ');π 17 : WRITELN (ziperror : 3, ' Too many files ');π 18 : WRITELN (ziperror : 3, ' Could NOT open file ');π 1..90 : WRITELN (ziperror : 3, ' Exec DOS error ');π 98 : WRITELN (ziperror : 3, ' requested file not produced ');π 99 : WRITELN (ziperror : 3, ' archive file not found');π END;π END;πππPROCEDURE PKZIPInit;π BEGINπ PKZIP := FSearch('PKZIP.EXE',GetEnv('PATH'));π PKUNZIP := FSearch('PKUNZIP.EXE',GetEnv('PATH'));π ZIPError := 0;π ZIPDefaultZIPOpts := '-n';π ZIPFileName := '';π ZIPDPath := '';π EraseCount := 0;π EraseSizeK := 0;π END;πππPROCEDURE ShowEraseStats;π {-Show statistics at the end of run}π BEGINπ WRITELN ('Files Erased: ', EraseCount,π ' bytes used: ', EraseSizeK DIV 2, 'k');π END;πππFUNCTION UnZIPFile ( ZIPOpts, ZIPName, DPath, fspec : STRING; qt : BOOLEAN) : BOOLEAN;πVAR s, zname : STRING;π i, j : INTEGER;π BEGINπ ZIPError := 0;π UnZIPFile := TRUE;π s := '';π IF ZIPOpts <> '' THEN s := s + ZIPOptsπ ELSE s := s + ZIPDefaultZIPOpts;ππ IF ZIPName <> '' THEN zname := ZIPNameπ ELSE zname := ZIPFileName;π IF NOT FileExists (zname) THENπ BEGINπ WRITELN ('zname: [', zname, ']');π UnZIPFile := FALSE;π ZIPError := 99;π EXIT;π END;ππ s := s + ' ' + zname;ππ IF DPath <> '' THEN s := s + ' ' + DPathπ ELSE s := s + ' ' + ZIPDPath;π s := s + ' ' + fspec;π ZIPError := ExecuteCommand (PKUNZIP,s,qt);π IF ZIPError > 0 THENπ BEGINπ WRITELN ('PKUNZIP start failed ', ZIPError, ' [', s, ']');π UnZIPFile := FALSE;π ENDπ ELSE BEGINπ i := POS ('*', fspec);π j := POS ('?', fspec);π IF (i = 0) AND (j = 0) THENπ BEGINπ IF NOT FileExists (DPath + fspec) THENπ BEGINπ UnZIPFile := FALSE;π ZIPError := 98;π END;π END;π END;π END;ππFUNCTION ZIPFile ( ZIPOpts, ZIPName, fspec : STRING; qt : BOOLEAN) : BOOLEAN;πVAR s, zname : STRING;π i, j : INTEGER;π BEGINπ ZIPError := 0;π ZIPFile := TRUE;π s := '';π IF ZIPOpts <> '' THEN s := s + ZIPOptsπ ELSE s := s + ZIPDefaultZIPOpts;ππ IF ZIPName <> '' THEN zname := ZIPNameπ ELSE zname := ZIPFileName;π s := s + ' ' + zname;π s := s + ' ' + fspec;π ZIPError := ExecuteCommand (PKZIP,s,qt);π IF ZIPError > 0 THENπ BEGINπ WRITELN ('PKZIP start failed ', ZIPError, ' [', s, ']');π ZIPFile := FALSE;π ENDπ ELSE BEGINπ IF NOT FileExists (ZIPname + '.ZIP') THENπ BEGINπ ZIPFile := FALSE;π ZIPError := 98;π END;π END;π END;πππ BEGINπ PKZIPInit;π END.π
